Pensieve Header: Poly-only β-Alexander.

<< KnotTheory`
GD[K_] := GD @@ (
PD[K] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],
Ar[l,i,+1], Ar[j,i,-1]
]
)

Draw[expr_] := expr /. gd_GD:> Draw[gd];
Draw[gd_GD] := Module[
{n=Length[gd], h, k=0},
Graphics[{
Line[{{0,0}, {2n+1,0}}],
Table[Text[i, {i,-0.3}], {i,2n}],
(List@@gd) /.  {
Ar[i_, j_, s_] :> {
h=Abs[i-j]/2;
BezierCurve[{
{i,0},{i,h}, {(i+j)/2, h}, {j,h}, {j,0}
}, SplineDegree -> 2],
Text[s*(++k), {(i+j)/2, h-0.3}],
Line[{{j-0.2, 0.4}, {j,0}, {j+0.2, 0.4}}]
}
}
}
]
];
Draw[GD[Knot[8,17]]]

βSimplify=Factor;
SetAttributes[βCollect, Listable];
βCollect[B[ω_, σ_, μ_]] := B[
βSimplify[ω],
Collect[σ, _h, βSimplify],
Collect[μ, _h, Collect[#, _t, βSimplify]&]
];
(* "L" for "Labels" *)
hL[β_] := Union[Cases[β, h[s_] :> s, Infinity]];
tL[β_] := Union[Cases[β, t[s_]|(Subscript[T, s_]) :> s, Infinity]];
gL[β_] := Union[hL[β], tL[β]];
SetAttributes[βForm, Listable];
βForm[B[ω_, σ_, μ_]] := Module[
{tails, heads, mat},
tails = tL[B[ω, σ, μ]]; heads = hL[B[ω, σ, μ]];
mat = Outer[βSimplify[Coefficient[μ, h[#1] t[#2]]]&, heads, tails];
PrependTo[mat, t /@ tails];
mat = Prepend[Transpose[mat], Prepend[h /@ heads, ω]];
AppendTo[mat, Prepend[βSimplify[Coefficient[σ, h[#]]]& /@ heads, "σ"]];
MatrixForm[mat]
];

R[x_, y_] := B[1, (Subscript[T, x])h[y], ((Subscript[T, x])-1)t[x]h[y]];
Rinv[x_, y_] := B[1, ((Subscript[T, x])^(-1))h[y], (((Subscript[T, x])^(-1))-1)t[x]h[y]];
tm[x_, y_, z_][β_] := β /. {t[x]->t[z], t[y]->t[z], (Subscript[T, x])->(Subscript[T, z]), (Subscript[T, y])->(Subscript[T, z])};
hm[x_, y_, z_][B[ω_, σ_, μ_]] := Module[
{γx= D[μ, h[x]], γy=D[μ, h[y]], M=μ /. h[x]|h[y] -> 0},
B[ω,
(σ /. h[x]|h[y] -> 0) + h[z]Replace[D[σ, h[x]], 0->1]Replace[D[σ, h[y]], 0->1],
M+h[z](γx+Replace[D[σ, h[x]], 0->1]γy)
] // βCollect
];
swap[x_,y_][B[ω_, σ_, μ_]] := Module[
{α, β, γ, δ, ϵ},
α = Coefficient[μ, h[x]t[y]];
β = D[μ, t[y]] /. h[x] -> 0;
γ = D[μ, h[x]] /. t[y] -> 0;
δ = μ /. h[x]|t[y] -> 0;
ϵ = ω/(ω+α);
B[ω+α, σ, Plus[
α/ϵ(1+(Replace[D[σ, h[x]], 0->1]-1-α/ω)*ϵ)h[x]t[y],
β/ϵ(1+(Replace[D[σ, h[x]], 0->1]-1-α/ω)*ϵ)t[y],
γ*h[x],
(δ-ϵ*γ*β/ω)/ϵ
]] // βCollect
];
gm[x_,y_,z_][β_] := β // swap[y,x] // hm[x,y,z] // tm[x,y,z];
B /: B[ω1_, σ1_, μ1_]B[ω2_, σ2_, μ2_] := B[ω1*ω2, σ1+σ2, μ1+μ2];

{
β= B[ω[(Subscript[T, 1]),(Subscript[T, 2]),(Subscript[T, 3]),(Subscript[T, 4])], 1, Sum[(Subscript[α, i])[(Subscript[T, 1]),(Subscript[T, 2]),(Subscript[T, 3]),(Subscript[T, 4])]t[i]h[1], {i,4}]],
β // tm[1,2,1],
t1=β // tm[1,2,1] // tm[1,3,1],
t2=β // tm[2,3,28] // tm[1,28,1],
t1==t2
} // βForm

{
β= B[ω, 1, Sum[(Subscript[α, 10i+j])t[i]h[j], {i,2}, {j,4}]],
β // hm[1,2,1],
t1=β // hm[1,2,1] // hm[1,3,1],
t2=β // hm[2,3,28] // hm[1,28,1],
t1==t2
} // βForm // ColumnForm

Clear[β];
{β1=B[ω, 1, h[1]t[1]α+h[2]t[1]β+h[1]t[2]γ+h[2]t[2]δ],
β1 // swap[1,1]
} // βForm

{
β= B[ω, 1, Sum[(Subscript[α, 10i+j])t[i]h[j], {i,2}, {j,3}]],
β // hm[1,2,1],
t1 = β // hm[1,2,1] // swap[1,1],
t2 = β // swap[1,1] // swap[2,1] //  hm[1,2,1],
First[t1]==First[t2],
Last[t1]==Last[t2] // Simplify
} // βForm // ColumnForm

{
β= B[ω, 1, Sum[(Subscript[α, 10i+j])t[i]h[j], {i,3}, {j,2}]],
t1 = β // tm[1,2,1] // swap[1,1],
t2 = β // swap[1,2] // swap[1,1] //  tm[1,2,1],
First[t1]==First[t2],
Last[t1]==Last[t2] // Simplify
} // βForm // ColumnForm

{
β= B[ω, 1, Sum[(Subscript[α, 10i+j])t[i]h[j], {i,4}, {j,4}]],
t1 = β // gm[1,2,1] // gm[1,3,1],
t2 = β // gm[2,3,2] // gm[1,2,1],
First[t1]==First[t2],
Last[t1]==Last[t2] // Simplify
} // βForm // ColumnForm

{Alexander[K=Knot[8,17]][X], Draw[GD[K]]}

(β=Times @@ GD[K] /. {Ar[x_,y_,+1] :> R[x,y],  Ar[x_,y_, -1] :> Rinv[x,y]}) // βForm

β=Times @@ GD[K] /. {Ar[x_,y_,+1] :> R[x,y],  Ar[x_,y_, -1] :> Rinv[x,y]};
Table[
{k,(β = β // gm[1,k,1])// βForm, Collect[Last[β] /. t[i_] :> 1, _h, Simplify]},
{k, 2, 2Crossings[K]}
] // ColumnForm

β

{Alexander[K=Knot[8,17]][X], Draw[GD[K]]}

β=Times @@ GD[K] /. {Ar[x_,y_,+1] :> R[x,y],  Ar[x_,y_, -1] :> Rinv[x,y]};
indices=Range[2Crossings[K]];
Table[
j=RandomInteger[{1,k-1}];
β = β // gm[indices[[j]],indices[[j+1]],indices[[j]]];
indices=Delete[indices, j+1];
{indices,β// βForm; Collect[Last[β] /. t[i_] :> 1, _h, Simplify[1+#]&]},
{k,2Crossings[K], 2, -1}
] // ColumnForm

β // βForm